VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "IniManager"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'This module maintains the private ini file for a project by providing access to retrieve
'or modify its contents.

'Methods include:
'  AddKey
'  DeleteKey
'  GetSection                 Returns an array of all keys for the given section.
'  GetAllSections
'  GetKeyValue                Returns the "profile string" for the given key.
'  GetAllKeys                 Returns an array of key names under a section.
'  WriteKeyValue              Writes the "profile string" for the given key.
'  WriteSection

'Properties:
'  FileName Get/Let        sets the INI file associated with the instance of this class

Private Const m_ModuleName = "ProjectINI"

Private m_FileName          As String  'the ini file associated with this class instance

Private Const Failed = False
Private Const Succeeded = True

Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
        'Under Windows NT, some private ini files will actually be implemented
        'in the registry.  A list of these files can be found in the
        'HKEY_LOCAL_MACHINE\Software\Microsoft\WindowsNT\CurrentVersion\IniFileMapping key in
        'the registry.

Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileStringKeys Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName$, ByVal lpszKey&, ByVal lpszDefault$, ByVal lpszReturnBuffer$, ByVal cchReturnBuffer&, ByVal lpszFile$) As Long
Private Declare Function GetPrivateProfileStringSections Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName&, ByVal lpszKey&, ByVal lpszDefault$, ByVal lpszReturnBuffer$, ByVal cchReturnBuffer&, ByVal lpszFile$) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
        'If lpKeyName is vbNullString, the lpReturnedString buffer will be
        'loaded with a list of the keys for the specified section.  Each key
        'will be terminated with a NULL.  If lpAppName is null, a list of sections
        'is returned in lpReturnedString(Windows 32-bit only).

Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpString As String, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long

' Constants used to size buffers
Const mc_Max_SectionBuffer = 65536
Const mc_Max_EntryBuffer = 8192


'----------------------------------------------------------------------------
' AddKey
'
'Appends key under section
'Returns 0 for success, -1 for fail
'----------------------------------------------------------------------------
Public Function AddKey(sSection As String, sNewKey As String, sKeyValue As String) As Integer

    Dim success As Long

  ' Write the new key
    success = WritePrivateProfileString(sSection, sNewKey, sKeyValue, m_FileName)

    If success = 0 Then
        AddKey = -1
    Else
        AddKey = 0
    End If

End Function



'----------------------------------------------------------------------------
' DeleteKey
'
' Delete the specified key
' Returns 0 for success, -1 for fail
'----------------------------------------------------------------------------
Public Function DeleteKey(sSection As String, sKeyToDelete As String) As Integer

    Dim success As Long

  ' Delete the specified key
    success = WritePrivateProfileString(sSection, sKeyToDelete, vbNullString, m_FileName)

    If success = 0 Then
        DeleteKey = -1
    Else
        DeleteKey = 0
    End If

End Function



'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
Public Property Get FileName() As String
    FileName = m_FileName
End Property


'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
Public Property Let FileName(sNewValue As String)
    m_FileName = sNewValue
End Property



'----------------------------------------------------------------------------
' GetSection
'
' Returns with all keys and key values for the given section.
'
' Reference: className.GetSection sSection
'----------------------------------------------------------------------------
Public Function GetSection(sSection As String) As String()

    On Error GoTo EH

    Dim characters  As Long
    Dim KeyList     As String
    Dim nPos        As Integer
    Dim nCnt        As Integer
Dim sary_KeyList() As String

    KeyList = String$(mc_Max_SectionBuffer, 0)
    
  ' Retrieve the list of keys in the section: pass 0 (vbNullString) for lpKeyName
  ' i.e., GetPrivateProfileSection(lpSection, lpKey, lpDefault, lpReturnedList, nSize, lpFile)
    characters = GetPrivateProfileSection(sSection, KeyList, mc_Max_SectionBuffer - 1, m_FileName)
    
  ' count the keys so we can dimension an array to hold them and their values
    nPos = InStr(KeyList, Chr$(0))
    Do While nPos > 1
        nCnt = nCnt + 1
        If Mid$(KeyList, nPos + 1, 1) <> Chr$(0) Then
            nPos = InStr(nPos + 1, KeyList, Chr$(0))
        Else
            Exit Do
        End If
    Loop


    ReDim sary_KeyList(0 To nCnt) As String
    
  ' Load keys into sary_KeyList
    nCnt = 0
    Do
        nPos = InStr(KeyList$, Chr$(0))

        If nPos > 1 Then
            sary_KeyList(nCnt) = Mid$(KeyList$, 1, nPos - 1)
            nCnt = nCnt + 1
            KeyList$ = Mid$(KeyList$, nPos + 1)
            If Mid$(KeyList, 1, 1) = Chr$(0) Then
                Exit Do
            End If
        End If

    Loop While nPos > 1

GetSection = sary_KeyList
    Exit Function

EH:

    Dim nRet As Integer

    nRet = MsgBox(Err.Number & ", " & Err.Description, vbAbortRetryIgnore + vbExclamation, m_ModuleName & ", Sub GetSection")

    Select Case nRet
        Case vbAbort
            Exit Function
        Case vbRetry
            If IsIDE Then Stop
            Resume 0
        Case vbIgnore
            Resume Next
    End Select

End Function



'----------------------------------------------------------------------------
' GetAllSections
'
' Returns an array of the sections in the ini file associated with this class
'----------------------------------------------------------------------------
Public Function GetAllSections() As String()

    On Error GoTo EH

    Dim characters  As Long
    Dim SectionList As String
    Dim nPos        As Integer
    Dim nCnt        As Integer
Dim sary_SectionList() As String


    SectionList$ = String$(mc_Max_EntryBuffer, 0)
    
  ' Retrieve the list of sections by passing 0 (vbNullString) for both section and key;
  ' i.e., GetPrivateProfileString(lpSection, lpKey, lpDefault, lpReturnedList, nSize, lpFile)
    characters = GetPrivateProfileStringSections(0, 0, "", SectionList$, mc_Max_EntryBuffer - 1, m_FileName)
    
  ' count the sections so we can dimension an array to hold them
    nPos = InStr(SectionList$, Chr$(0))
    Do While nPos > 1
        nCnt = nCnt + 1
        If Mid$(SectionList$, nPos + 1, 1) <> Chr$(0) Then
            nPos = InStr(nPos + 1, SectionList$, Chr$(0))
        Else
            Exit Do
        End If
    Loop

    ReDim sary_SectionList(0 To nCnt) As String
    nCnt = 0
    
  ' Load sections into sary_SectionList
    Do
        nPos = InStr(SectionList$, Chr$(0))

        If nPos > 1 Then
            sary_SectionList(nCnt) = Mid$(SectionList$, 1, nPos - 1)
            nCnt = nCnt + 1
            SectionList$ = Mid$(SectionList$, nPos + 1)
            If Mid$(SectionList$, 1, 1) = Chr$(0) Then
                Exit Do
            End If
        End If

    Loop While nPos > 1

GetAllSections = sary_SectionList

    Exit Function

EH:

    Dim nRet As Integer

    nRet = MsgBox(Err.Number & ", " & Err.Description, vbAbortRetryIgnore + vbExclamation, m_ModuleName & ", Sub GetAllSections")

    Select Case nRet
        Case vbAbort
            Exit Function
        Case vbRetry
            If IsIDE Then Stop
            Resume 0
        Case vbIgnore
            Resume Next
    End Select

End Function


'----------------------------------------------------------------------------
' GetKeyValue
'
' returns the key value for the given key
'
' Reference: className.GetKeyValue sSection, sKey, sItem
'
' Requires:
'   strSection     - .ini file section: [section name]
'   strKey         - .ini file key under the section: key=value
'
' Returned: - the key value
'----------------------------------------------------------------------------
Public Function GetKeyValue(strSection As String, strKey As String) As String

    On Error GoTo EH

    Dim lngCharacters   As Long
    Dim strKeyList      As String
    Dim strKeyName      As String
    Dim strSectionName  As String
Dim strKeyValue As String

    strSectionName = strSection
    strKeyName = strKey
    strKeyList = String$(mc_Max_SectionBuffer - 1, 0)

  ' Retrieve the list of values for the key in the section.
  ' i.e., GetPrivateProfileString(lpSection, lpKey, lpDefault, lpReturnedList, nSize, lpFile)
    lngCharacters = GetPrivateProfileString(strSectionName, strKeyName, "", strKeyList, mc_Max_SectionBuffer - 1, m_FileName)

    If lngCharacters <> 0 Then
        strKeyValue = Left$(strKeyList, lngCharacters)
        GetKeyValue = strKeyValue
        Exit Function
    End If

GetKeyValue = strKeyValue
    
    Exit Function

EH:

    Dim nRet As Integer

    nRet = MsgBox(Err.Number & ", " & Err.Description, vbAbortRetryIgnore + vbExclamation, m_ModuleName & ", Sub GetKeyValue")

    Select Case nRet
        Case vbAbort
            Exit Function
        Case vbRetry
            If IsIDE Then Stop
            Resume 0
        Case vbIgnore
            Resume Next
    End Select

End Function



'----------------------------------------------------------------------------
' GetAllKeys
'
' Returns with all keys under the given section.
'
' Reference: className.GetAllKeys strSection
'----------------------------------------------------------------------------
Public Function GetAllKeys(sSection As String) As String()

    On Error GoTo EH

    Dim characters  As Long
    Dim KeyList     As String
    Dim nPos        As Integer
    Dim nCnt        As Integer
Dim sary_KeyList() As String

    KeyList = String$(mc_Max_SectionBuffer, 0)

  ' Retrieve the list of keys in the section: pass 0 (vbNullString) for lpKeyName
  ' i.e., GetPrivateProfileString(lpSection, lpKeyName, lpDefault, lpReturnedList, nSize, lpFile)
    characters = GetPrivateProfileStringKeys(sSection, 0, "", KeyList, mc_Max_SectionBuffer - 1, m_FileName)

  ' count the keys so we can dimension an array to hold them
    nPos = InStr(KeyList, Chr$(0))
    Do While nPos > 1
        nCnt = nCnt + 1
        If Mid$(KeyList, nPos + 1, 1) <> Chr$(0) Then
            nPos = InStr(nPos + 1, KeyList, Chr$(0))
        Else
            Exit Do
        End If
    Loop


    ReDim sary_KeyList(0 To nCnt) As String

  ' Load keys into sary_KeyList
    nCnt = 0
    Do
        nPos = InStr(KeyList$, Chr$(0))

        If nPos > 1 Then
            sary_KeyList(nCnt) = Mid$(KeyList$, 1, nPos - 1)
            nCnt = nCnt + 1
            KeyList$ = Mid$(KeyList$, nPos + 1)
            If Mid$(KeyList, 1, 1) = Chr$(0) Then
                Exit Do
            End If
        End If

    Loop While nPos > 1

GetAllKeys = sary_KeyList

    Exit Function

EH:

    Dim nRet As Integer

    nRet = MsgBox(Err.Number & ", " & Err.Description, vbAbortRetryIgnore + vbExclamation, m_ModuleName & ", Sub GetAllKeys")

    Select Case nRet
        Case vbAbort
            Exit Function
        Case vbRetry
            If IsIDE Then Stop
            Resume 0
        Case vbIgnore
            Resume Next
    End Select

End Function



'----------------------------------------------------------------------------
' WriteKeyValue
'
' Updates key under section
' Returns -1 if there is an error, 0 otherwise
'----------------------------------------------------------------------------
Public Function WriteKeyValue(sSection As String, sKey As String, sKeyValue As String) As Integer
    Dim lngResult As Long
    lngResult = WritePrivateProfileString(sSection, sKey, sKeyValue, m_FileName)

If lngResult = 0 Then
WriteKeyValue = -1
MsgBox "bug"
Else
WriteKeyValue = 0
End If

End Function



'----------------------------------------------------------------------------
' WriteSection
'
' Sets all of the key names and values for a specified section in a private
' initialization file.  If the section does not exist, it will be appended to
' the file; if the section exists, all current key names and values are
' replaced by those passed in.

' strString is a list of key and value strings.  Each string is separated by a
' null character (Chr$(0)), with a double null after the final string.
'Returns -1 if there is an error, 0 otherwise.
'----------------------------------------------------------------------------
Public Function WriteSection(ByVal strSectionName As String, ByVal strString As String) As Integer
    Dim lResult As Long
    lResult = WritePrivateProfileSection(strSectionName, strString, m_FileName)

If lResult = 0 Then
WriteSection = -1
Else
WriteSection = 0
End If

End Function



'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
Private Function IsIDE() As Boolean
    'determines whether we are compiled or running in the IDE

    On Error GoTo EH

    IsIDE = False

  ' The following divide by zero fails in IDE
    Debug.Print 1 / 0

    Exit Function

EH:
    IsIDE = True

End Function

'----------------------------------------------------------------------------
' DelSection
'
' Deletes a whole section from the ini file.
' ---
' Args: SecName, the name of the section to delete
'Returns: -1 on error, 0 otherwise.
'---

Public Function DelSection(ByVal SecName As String) As Integer
Dim res As Long

res = WritePrivateProfileString(SecName, 0&, 0&, m_FileName)
    
    If res = 0 Then
DelSection = -1
Else
DelSection = 0
    End If

End Function

